proc lrand {l} {
	set i [expr int ( rand() * [llength $l])]
	return [lindex $l $i]
}

proc MAGELLAN__nb_descendants {LC} { return [llength [CSS++ MSN_ROOT "([join $LC ,]) ~ *"]]}
proc MAGELLAN__nb_enfants {LC} { return [llength [CSS++ MSN_ROOT "([join $LC ,]) >"]]}



proc MAGELLAN__stochastic_switch {list_of_case} {
    set sum 0
  foreach element $list_of_case {
		set sum [expr $sum + [lindex $element 0]]
  }
    set r [expr rand () * $sum]
    set sum 0
  foreach element $list_of_case {
		set sum [expr $sum + [lindex $element 0]]
		if {$r < $sum} {
				return [lindex $element 1]
		}
  }
  puts "Error in the stochastic_switch"
  puts $list_of_case
}

proc MAGELLAN_INTERSECTION {l1 l2} {
	set rep [list]
	set r [concat $l1 $l2] 
	set r [lsort $r]
	set i 0 
	while {$i < [llength $r] } {
		if {[lindex $r $i] == [lindex $r [expr $i + 1] ] } {
			lappend rep [lindex $r $i] 
			incr i 1
		} 
		incr i 
	}
	return $rep
}

proc MAGELLAN__PERMUTATION {x l} {
   if {$l == {} } { return [list] }
   set r [expr $x % [llength $l] ]
   return [concat [lindex $l $r] [MAGELLAN__PERMUTATION [expr $x /  [llength $l]] [lreplace $l $r $r]]]
}

#proc CSS++ {args} {return "A  B C"}
proc MAGELLAN_MAGIC_FUNCTION {n x} {
	return [expr $n - abs ($n - 2 * $x) +1 ]
}
proc MAGELLAN_UPDATE_CSS {previous_rules type} {
	set specialisation [lindex $type 1]
	switch -regexp -- $type {	
		child_* {
			set css [list NODE $specialisation]
			if {$previous_rules != ""} {			
				set ruleToApply [list [list AXE GROUP $previous_rules] {AXE CHILDREN} $css]
			} else {
				set ruleToApply  [list [list AXE CHILDREN] $css]
			}
		}
		descendant_* {
			set css [list NODE $specialisation]
			if {$previous_rules != ""} {	
				set ruleToApply [list [list AXE GROUP $previous_rules] {AXE DESCENDANTS} $css]
			} else {
				set ruleToApply  [list [list AXE DESCENDANTS] $css]
			}
		}
		mark* - 
		specialisation* {
			set css [list NODE $specialisation]
			if {$previous_rules != ""} {			
				lappend previous_rules $css
				set ruleToApply $previous_rules
			} else {
				set ruleToApply [list $css]
			}
		}
		CHILDREN -
		DESCENDANTS {
			set css [list AXE $type]
			if {$previous_rules != ""} {												
				set ruleToApply [list [list AXE GROUP $previous_rules] $css {NODE *}]
			} else {
				set ruleToApply [list $css]
			}
		}
		default {
			puts "type is incorrect $type"
		}
	}
	return $ruleToApply 
}

proc traceGene {} { 
	foreach mtd [gmlObject info methods GENE] { if {$mtd != "attribute" && $mtd != "newName" && $mtd != "unknown"} {Inject_code GENE $mtd "global GENE_$mtd ; incr GENE_$mtd" {} }} 
	foreach mtd [gmlObject info methods INDIVIDU] { if {$mtd != "attribute" && $mtd != "newName" && $mtd != "unknown"} {Inject_code INDIVIDU $mtd "global INDIVIDU_$mtd ; incr INDIVIDU_$mtd" {} }} 
	foreach spec [concat [gmlObject info specializations MAGELLAN__ATTRIBUT] MAGELLAN__ATTRIBUT] { 
		foreach {nul class mtd arg} [gmlObject info interface $spec] { if {$mtd != "attribute" && $mtd != "newName" && $mtd != "unknown" && $mtd != ""} {
				Inject_code $spec "$mtd" "global ${spec}_$mtd ; incr ${spec}_$mtd" {} }
		} 
	}
}
proc printGene {} {
	foreach mtd [gmlObject info methods GENE] {
		global GENE_$mtd ;   if {[info exist GENE_$mtd]} { puts "GENE    $mtd : [set "GENE_$mtd"]" ; set GENE_$mtd 0
	}
	}
	foreach mtd [gmlObject info methods INDIVIDU] {
		global INDIVIDU_$mtd ;   if {[info exist INDIVIDU_$mtd]} { puts "INDIVIDU $mtd : [set "INDIVIDU_$mtd"]" ; set INDIVIDU_$mtd 0
	}
	}
	foreach spec [concat [gmlObject info specializations MAGELLAN__ATTRIBUT] MAGELLAN__ATTRIBUT]  { 
	
		foreach {nul class mtd arg} [gmlObject info interface $spec] { 
			global ${spec}_$mtd
			if {[info exist ${spec}_$mtd]} { puts "$spec $mtd : [set "${spec}_$mtd"]" ; set ${spec}_$mtd 0 
		}
		}
	}

}
proc MAGELLAN_SET_DYNASTY {d} {
	global __MAGELLAN_DYNASTY 
	if {[info exist __MAGELLAN_DYNASTY] && [gmlObject info exists object $__MAGELLAN_DYNASTY] } {
		$__MAGELLAN_DYNASTY dispose
	}
	set __MAGELLAN_DYNASTY $d
}
proc MAGELLAN_GET_DYNASTY {} {
	global __MAGELLAN_DYNASTY 
	return $__MAGELLAN_DYNASTY
}

proc MAGELLAN_SF {x} {return [expr (1 + atan ( 10 * ($x -0.65) ) / (2*atan (1)))/2] }
proc MAGELLAN_Normal_Seuil_Function {x} {return [expr ([MAGELLAN_SF $x] -  [MAGELLAN_SF 0])/ ([MAGELLAN_SF 1] - [MAGELLAN_SF 0])] }